perm filename FILL.OLD[MSS,LCS] blob
sn#096364 filedate 1974-04-05 generic text, type T, neo UTF8
00010 SUBROUTINE FILLER
00110 COMMON /FL/IC,N,NQ,RZ,IXRX,XGP,RXGP
00123 COMMON /RZ/RSZ,IPLT,RJB,CENTR
00136 COMMON /RC/MCLEF(200),IST(4000),MFILL(200)
00150 REAL LF
00200 COMMON Q(200),R(200),E(200),NN
00210 COMMON/LL/L
00600
01400 KK=0
01490 206 DO 205 J=IC,MCLEF(1)
01500 CALL UNPACK(J,M,N,MCLEF)
01505 KK=KK+1
01510 E(KK)=0
01520 IF(L.LT.100000000)GO TO 208
01521 E(KK)=-1
01522 IF(KK.EQ.1)GO TO 207
01523 E(KK)=-2
01524 Q(KK)=Q(K)
01525 R(KK)=R(K)
01526 KK=KK+1
01527 E(KK)=-1
01528 207 K=KK+1
01530 208 Q(KK)=(M+RJB)*RSZ
01540 R(KK)=(N+CENTR)*RSZ
01541 205 IF(Q(KK).EQ.Q(KK-1))E(KK)=-1
01542 J=KK+1
01545 CC E(1)=-1
01550 R(J)=R(K)
01555 Q(J)=Q(K)
01560 E(J)=-2
01570 C ABOVE??? 0 , 1 OR -1 ???
01580 RR=RSZ
01585 IF(IXRX)RR=RR*1.7
01590 C FOR XGP
01595 RSZ=1
01600 GO TO 201
01690 400 DO 40 K=1,KK
01695 J=2
01700 IF(E(K))J=3
01800 40 CALL LINES(Q(K),R(K),J)
01900 201 N=1
02000 4 J=0
02010 CALL DPYOUT(1)
02100 CC H=-1000
02200 Z=-1000
02300 DO 1 K=2,KK
02400 IF(E(K).NE.0)GO TO 1
02401 NN=K
02402 RA=R(K-1)
02403 IF(RA.LT.R(K))RA=R(K)
02404 IF(RA.LT.Z)GO TO 1
02412 IF(RA.NE.R(K))NN=K-1
02420 QA=Q(NN)
02430 QB=Q(NN+1)
02440 QC=Q(NN-1)
02450 RB=R(NN+1)
02460 CC RC=R(NN-1)
02470 ID=-1
02480 IF(QA-QC)ID=0
02490 JD=-1
02500 IF(QA-QB)JD=0
02505 IF(JD.NE.ID .OR. QA.EQ.QB .OR. QA.EQ.QC)GO TO 301
02510 CC X=((R(NN)-RC)*(QB-QC))/(QA-QC)+RC
02511 X=HGHT(R(NN),R(NN-1),QB,QC,QA)
02520 IF(X.LE.RB)GO TO 303
03200 301 Z=RA
03300 C FINDS HIGHEST LINE
03400 J=NN
03450 JJ=NN
03500 GO TO 1
03505 303 IF(E(NN+1).EQ.1..OR.E(NN+1).EQ.-2.)GO TO 301
03507 IF(E(NN+1))GO TO 1
03510 Z=RB
03520 IF(R(NN).GT.Z)Z=R(NN)
03530 J=NN+1
03547 JJ=NN
03600 1 CONTINUE
03700
03800 IF(J.EQ.0)GO TO 10
04000 JA=J-1
04100 C J = END OF HIGHEST LINE
04200 19 RT=Q(J)
04300 LF=Q(JA)
04400 RJ=R(J)
04500 RJ1=R(JA)
04600 16 E(J)=-1
04610 IF(JJ.NE.J)E(JJ)=1.
04700 C LINE USED
04800 CC HT=RJ-RJ1
04900 DIS=RT-LF
04950 M=2
05000 IF(KK.GT.60)M=3
05100 22 IF(DIS)M=-M
05110 X=-1
05155 J=3
05200
05300 17 DO 2 K=IFIX(LF),IFIX(RT),M
05310 RK=K
05500 CC Y=(HT*(RK-LF))/DIS+RJ1
05501 Y=HGHT(RJ,RJ1,RK,LF,RT)
05610 IF(X)CALL LINES(RK,Y,J)
05620 J=2
05700 H=-1000
05800
05900 18 DO 3 I=2,KK
06000 IF(E(I))GO TO 3
06100 C SKIP IF SAME LINE.
06200 QA=Q(I)
06300 QB=Q(I-1)
06400 IF((QA.GT.RK.AND.QB.GT.RK).OR.(QA.LT.RK.AND.QB.LT.RK))GOTO 3
06500 C LINE WAS NOT UNDER POINT K
06600 CC RA=R(I)
06700 CC RB=R(I-1)
06800 CC HX=RA-RB
06900 CC DX=QA-QB
07000 CC B=(HX*(RK-QB))/DX+RB
07001 B=HGHT(R(I),R(I-1),RK,QB,QA)
07100 IF(B.GT.Y)GO TO 3
07200 IF(B.LE.H)GO TO 3
07300 H=B
07400 IX=I
07500 C FOUND HIGHEST NEW POINT
07600 3 CONTINUE
07700 IF(H.EQ.Y)GO TO 31
07800 C WIPES OUT THIS LINE SEG.
07900 30 IF(RK.NE.Q(IX).AND.RK.NE.Q(IX-1))E(IX)=1
08000 C TOUCHING END OF SEG. DOES NOT COUNT.
08100
08200 IF(H.EQ.-1000)GO TO 31
08310 CALL LINES(RK,H,J)
08320 IF(X.GT.0)CALL LINES(RK,Y,J)
08330 X=-X
08340 GO TO 2
08350 31 X=1
08500 2 CONTINUE
08600
08610 GO TO 4
11705 10 CALL DPYOUT(1)
11800 RSZ=RR
12000 END
13000
13100 FUNCTION HGHT(A,B,C,D,E)
13200 HGHT=((A-B)*(C-D))/(E-D)+B
13300 END